The X-Philes (2nd Revision)

home *** CD-ROM | disk | FTP | other *** search

/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / cel_nav.42 < prev next >

Wrap

Internet Message Format | 1995-03-23 | 22KB

From comp.sys.handhelds Mon Jan 28 16:08:39 1991 Path: mentor.cc.purdue.edu!purdue!news.cs.indiana.edu!samsung!zaphod.mps.ohio-state.edu!ncar!ames!uhccux!akala!metcalf From: metcalf@akala.ifa.hawaii.edu (Tom Metcalf) Newsgroups: comp.sys.handhelds Subject: Re: Celestial Navigation with HP-48SX Summary: Version 4.2 fixes bug in 4.0 Message-ID: <11161@uhccux.uhcc.Hawaii.Edu> Date: 28 Jan 91 19:20:48 GMT References: <11126@uhccux.uhcc.Hawaii.Edu> Sender: news@uhccux.uhcc.Hawaii.Edu Followup-To: comp.sys.handhelds Organization: Institute For Astronomy, Hawaii Lines: 1335 Last week I posted version 4.0 of my sight reduction program. There was a bug in the ADV program which caused it to crash when the speed from the INIT menu was set to zero. Here is version 4.2 which corrects this problem. The instructions are unchanged and I have not reposted them. The program with instructions is available via anonymous ftp from the machine mamane.ifa.hawaii.edu in the directory pub/metcalf. Sorry for any inconvenience! Tom Metcalf metcalf@uhifa.ifa.hawaii.edu ----------------------- CUT HERE AND AT BOTTOM ------------------ %%HP: T(3)A(D)F(.); DIR SOLVE \<< SAVES FFIX DEG 0 0 0 0 0 GSUM a0 \->NUM 'A0' STO a1 \->NUM 'A1' STO EV1 \->NUM DUP '\Ga1' STO EIGEN 'E1' STO EV3 \->NUM DUP '\Ga3' STO EIGEN 'E3' STO EV2 \->NUM DUP '\Ga2' STO EIGEN 'E2' STO R E1 DOT '\Gb1' STO IF '\Ga1==0 AND \Gb1==0' THEN "AMBIGUOUS SOLUTION" MESS KILL END R E2 DOT '\Gb2' STO R E3 DOT '\Gb3' STO 'G\Gm' '\Gm' { \GmST LBND UBND } ROOT DROP IF '\Gm>\Ga1 OR \Gm <LBND' THEN "ROOT ERROR" END UVW OUT CLLCD "Update DR?" 2 DISP DUP2 \->STR 4 DISP \->STR 5 DISP ASK IF 11.1 == THEN DUP2 FMT\-> 'DRLAT' STO FMT\-> 'DRLON' STO END RESTS RESTS \>> ADDOB \<< SAVES DEG RCLMENU 28 MENU \-> om \<< "Time/Altitude (hh.mmss)/" FMT + ":Time: :H_s: " { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> DTAG SWAP DTAG SWAP 0 \-> TM A n \<< TM HMS\-> 'TM' STO IF TM T1 < TM T2 > BODY "T" SAME NOT AND OR THEN "Error:Bad Time Press ENTER" MESS om MENU KILL END A CORRECT FMT\-> 'A' STO TM GHA1 GHA2 INTERP 180 RANGE TM DEC1 DEC2 INTERP IF 'SPD\=/0 ' THEN TF TM - SPD * 60 / CRS RMOVE SWAP 180 RANGE SWAP END OBS IFERR OBJ\-> THEN 3 ROLLD A { 1 3 } \->ARRY SWAP STO ELSE OBJ\-> ROT 1 + DUP 3 * 'n' STO ROT ROT \->LIST n ROLL n ROLL ROT A SWAP \->ARRY 'OBS' STO END \>> om MENU \>> RESTS \>> SETUP \<< RCLMENU 28 MENU \-> om \<< FFIX CLLCD 2 FREEZE MBODY TMENU "BODY?" PROMPT 'BODY' STO 0 MENU IF BODY "S" SAME THEN DO "SEMI-D? " FMT + SD \->FMT \->STR 'V' 2 \->LIST INPUT OBJ\-> FMT\-> 'SEMI' STO IF ' SEMI>.55' THEN "TOO LARGE:PRESS ENTER" MESS END UNTIL ' SEMI\<=.55' END END IF BODY "M" SAME BODY "VM" SAME OR THEN DO "HParallax? " FMT + HP \->FMT \->STR 'V' 2 \->LIST INPUT OBJ\-> FMT\-> 'HP' STO IF 'HP> 1.2' THEN "TOO LARGE:PRESS ENTER" MESS END UNTIL 'HP <1.2' END END IF BODY "M" SAME BODY "S" SAME OR THEN CLLCD 2 FREEZE MLIMB TMENU "Limb?" PROMPT 'LU' STO 0 MENU END DO IF BODY "T" SAME THEN "Star" ":GHA\Gg: " G\Gg \->FMT \->STR + " :SHA: :DEC: " + ":TIM: " T\Gg \->HMS \->STR + + { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> HMS\-> DUP 'T1' STO DUP 'T\Gg' STO 1 + 'T2' STO FMT\-> DUP 'DEC1' STO 'DEC2' STO FMT\-> SWAP FMT\-> DUP 'G\Gg' STO + DUP 'GHA1' STO 15.041067 + 'GHA2' STO ELSE "Linear Interp 1" { ":GHA1: :DEC1: :TIM1: " { 1 0 } V } INPUT OBJ\-> HMS\-> 'T1' STO FMT\-> 'DEC1' STO FMT\-> 'GHA1' STO "Linear Interp 2" { ":GHA2: :DEC2: :TIM2: " { 1 0 } V } INPUT OBJ\-> HMS\-> 'T2' STO FMT\-> 'DEC2' STO FMT\-> 'GHA2' STO END IF 'T1\>=T2 ' THEN "Err:T1\>=T2:Press ENTER" MESS END IF 'GHA1> GHA2' THEN "GHA1>GHA2:Hit ENTER" MESS END UNTIL 'T1< T2 AND GHA1\<=GHA2' END IF 'SPD\=/0' THEN DR 4 FIX "TIME OF FIX? (hms)" TF \->HMS \->STR 'V' 2 \->LIST INPUT OBJ\-> HMS\-> 'TF' STO FFIX END om MENU \>> \>> INIT \<< RCLMENU 28 MENU \-> om \<< FFIX { { "INDEX" { \<< 0 MENU "INDEX? " FMT + INDX \->FMT "INDEX" \->TAG \->STR { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> FMT\-> 'INDX' STO 0 CONT \>> } } { "HEIGHT" { \<< 0 MENU "HEIGHT? (m)" HGT "HGT" \->TAG \->STR { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> '1_m' DOUNIT 'HGT' STO 0 CONT \>> } } { "C/S" { \<< 0 MENU "Motion? (True/Knots)" ":COURSE: " CRS \->FMT \->STR + " :SPEED: " SPD \->STR + + { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> '1_knot' DOUNIT 'SPD' STO FMT\-> 180 RANGE 'CRS' STO 0 CONT \>> } } { "P/T" { \<< 0 MENU "ENTER for std cond" { ":PRESS (mb): 1010 :TEMPER (C): 10" -14 V } INPUT OBJ\-> '1_\^oC' DOUNIT 'TMPTR' STO '1_mbar ' DOUNIT 'PRESS' STO 0 CONT \>> } } { "FORMAT" { \<< 0 MENU FFMT 1 + IF DUP 3 == THEN DROP 0 END 'FFMT' STO CASE ' FFMT==2' THEN "(decimal)" END ' FFMT==1' THEN "(dd.mmt)" END ' FFMT==0' THEN "(dd.mmss)" END END 'FMT' STO FFIX 0 CONT \>> } } { "EXIT" { \<< 1 CONT \>> } } } TMENU DO CLLCD "INDEX " INDX \->FMT \->STR + 2 DISP "HEIGHT " HGT \->STR "m" + + 3 DISP 1 FIX "MOTION " CRS \->FMT \->STR + "T " + SPD \->STR + "kn" + 4 DISP "P/T " PRESS \->STR "mb " + TMPTR \->STR + "C" + + 5 DISP FFIX "FORMAT " CASE ' FFMT==2' THEN "Decimal" END ' FFMT==1' THEN "HMT" END ' FFMT==0' THEN "HMS" END "?" END + 6 DISP 3 FREEZE HALT 0 MENU UNTIL END om MENU \>> \>> ADDDR \<< SAVES 0 RCLMENU 28 MENU \-> n om \<< OBS IFERR OBJ\-> THEN DROP 0 ELSE OBJ\-> DROP DROP END 'n' STO FMT DRLAT \->FMT "DR_LAT" \->TAG \->STR " " + DRLON \->FMT "DR_LON" \->TAG \->STR + { 1 0 } 'V' 3 \->LIST 28 MENU INPUT 0 MENU OBJ\-> DTAG FMT\-> SWAP DTAG FMT\-> 90 n 1 + 3 2 \->LIST \->ARRY 'OBS' STO om MENU \>> RESTS \>> DR \<< RCLMENU 28 MENU \-> om \<< FFIX "Dead Reckoning? " FMT + DRLAT \->FMT "DR_LAT" \->TAG \->STR " " + DRLON \->FMT "DR_LON" \->TAG \->STR + { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> FMT\-> 'DRLON' STO FMT\-> 'DRLAT' STO om MENU \>> \>> PLOTP \<< SAVES DEG IF DEPTH 2 < THEN "LON/LAT NOT ON STACK" MESS KILL END 2 DUPN FMT\-> 'LAT' STO FMT\-> 'LON' STO 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 \-> g d a l n N sc sc\Gl ssz d0 d1 ll lm top bot \<< "Scale? (NMiles)" { "9" -1 V } INPUT OBJ\-> ABS '1_nmi' DOUNIT IF DUP 0 == THEN DROP "SCALE\=/0 PLEASE" MESS KILL END 120 / DUP 'sc' STO LAT COS / 2.0469 * 180 MIN NEG 'sc\Gl' STO ERASE { # 0h # 0h } PVIEW LON sc\Gl + LON RANGE LAT sc + 90 MIN DUP 'top' STO DUP 3 ROLLD R\->C PMAX LON sc\Gl - LON RANGE LAT sc - -90 MAX DUP 'bot' STO DUP 3 ROLLD R\->C PMIN - 2 / 'sc' STO OBS OBJ\-> OBJ\-> DROP2 DUP 'N' STO 3 * DROPN 1 N FOR n DEPTH 'd0' STO OBS { n 1 } GET 'g' STO OBS { n 2 } GET 'd' STO OBS { n 3 } GET 'a' STO IF 'LAT- sc>d+90-a OR LAT+sc <d-90+a' THEN ELSE top d 90 a - + IF DUP 90 > THEN 180 SWAP - END MIN bot d 90 a - - IF DUP -90 < THEN 180 + NEG END MAX IF LAT d < THEN SWAP END DUP2 SWAP - DUP SIGN IF DUP 0 == THEN DROP 1 END SWAP ABS 90 a - PSCALE sc 32 / MAX * 'ssz' STO DUP 'lm' STO SWAP DUP 'll' STO - ssz / CEIL 0 SWAP FOR l g d a l ssz * ll + DUP lm IF ' ssz<0' THEN SWAP END IF > THEN DROP lm END LOP DUP C\->R SWAP g - NEG g + LON RANGE SWAP R\->C DEPTH d0 - ROLLD NEXT DEPTH d0 - 2 / 2 + 'd1' STO WHILE DEPTH d0 - DUP 1 > REPEAT IF d1 \=/ THEN OVER SWAP END LIMIT LINE END DEPTH d0 - DROPN END NEXT LAT COS DUP LON .0083333 ROT / - LAT R\->C SWAP LON .0083333 ROT / + LAT R\->C LINE LON LAT .0083333 - R\->C LON LAT .0083333 + R\->C LINE \>> { } PVIEW RESTS \>> ADV \<< SAVES DEG RCLMENU 28 MENU \-> om \<< 0 0 0 0 0 0 \-> \Gh d \Gl l n n3 \<< "Motion? (nmi,deg true)" { ":DISTANCE: :COURSE: " { 1 0 } V } INPUT OBJ\-> FMT\-> 180 RANGE '\Gh' STO '1_nmi' DOUNIT IF 'SPD\=/0 ' THEN DUP SPD / 'TF' STO+ END 60 / 'd' STO 2 FIX CLLCD "Old DR: " DRLAT \->FMT \->STR + " " + DRLON \->FMT \->STR + 4 DISP OBS IFERR OBJ\-> THEN DROP ELSE OBJ\-> DROP SWAP DUP 'n' STO * 'n3' STO 1 n FOR I I 1 DISP 3 ROLLD 'l' STO '\Gl' STO \Gl l d \Gh RMOVE SWAP 180 RANGE SWAP ROT n3 ROLLD n3 ROLLD n3 ROLLD NEXT { n 3 } \->ARRY 'OBS' STO END DRLON DRLAT d \Gh CCMOVE 'DRLAT' STO 'DRLON' STO "New DR: " DRLAT \->FMT \->STR + " " + DRLON \->FMT \->STR + 5 DISP FFIX 2 FREEZE \>> om MENU \>> RESTS \>> SAIL \<< SAVES RCLMENU 28 MENU \-> om \<< DEG 0 0 \-> fr\Gl frl \<< "From? " FMT + DRLAT \->FMT "Lat" \->TAG \->STR " " + DRLON \->FMT "Lon" \->TAG \->STR + { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> FMT\-> 'fr\Gl' STO FMT\-> 'frl' STO "TO? " FMT + tol \->FMT "Lat" \->TAG \->STR " " + to\Gl \->FMT "Lon" \->TAG \->STR + { 1 0 } 'V' 3 \->LIST INPUT OBJ\-> FMT\-> 'to\Gl' STO FMT\-> 'tol' STO CLLCD 2 FREEZE { { "RHUMB" \<< 0 MENU frl fr\Gl tol to\Gl RHUMB 0 CONT \>> } { "GC" \<< 0 MENU frl fr\Gl tol to\Gl GC 0 CONT \>> } { "WAY" \<< 0 MENU "Scale? (nmi)" { "" V } INPUT OBJ\-> '1_ nmi' DOUNIT 60 / frl fr\Gl tol to\Gl WAY 0 CONT \>> } { "VERT" \<< 0 MENU frl fr\Gl tol to\Gl VERTEX 0 CONT \>> } { "COMP" \<< 0 MENU "Composite" { ":Lat Limit: :Scale: " { 1 0 } V } INPUT OBJ\-> '1_nmi' DOUNIT 60 / SWAP FMT\-> frl fr\Gl tol to\Gl COMP 0 CONT \>> } { "EXIT" \<< 1 CONT \>> } } TMENU DO "Type?" PROMPT 0 MENU UNTIL END \>> om MENU \>> RESTS \>> WVIEW \<< 2 FIX { } SWAP { } 1 1 1 1 "Lat Lon Crs " FMT + 5 \->LIST DBR IF 1 \=/ THEN DROP2 ELSE SWAP DROP SWAP DUP ROT GET END FFIX \>> ERROR \<< SAVES DEG 0 0 0 0 0 0 0 0 \-> H1 H2 D1 D2 G1 G2 DT DH \<< OBS { 1 3 } GET 'H1' STO OBS { N 3 } GET 'H2' STO OBS { 1 2 } GET 'D1' STO OBS { N 2 } GET 'D2' STO OBS { 1 1 } GET 'G1' STO OBS { N 1 } GET 'G2' STO T2 T1 - GHA2 GHA1 - / G2 G1 - * 'DT' STO H2 H1 - 'DH' STO 1 DT / N \v/ / 57.3 H1 H2 + 2 / COS * * 225 D1 D2 + 2 / COS SQ * DH DT / SQ - \v/ / "ERR" \->TAG \>> RESTS \>> DRLAT 37.0204655112 DRLON 51.455945662 CORRECT \<< DEG FMT\-> INDX + HGT \v/ .0293 * - DUP DUP REFRACT SWAP COS CASE BODY "S" SAME THEN .002443 * SEMI END BODY "M" SAME THEN HP * HP .272476 * END BODY "VM" SAME THEN HP * 0 END 0 * 0 END LU * + SWAP - + \->FMT \>> RHUMB \<< \-> frl fr\Gl tol to\Gl \<< DEG to\Gl fr\Gl RANGE 'to\Gl' STO 'LN (TAN(45+tol/2)/TAN( 45+frl/2))' \->NUM '- \pi/180*(to\Gl-fr\Gl)' \->NUM R\->C ARG 180 RANGE DUP \->FMT "COURSE" \->TAG SWAP IF DUP COS ABS .0001 > THEN COS tol frl - SWAP / ELSE to\Gl fr\Gl - tol frl + 2 / COS * SWAP SIN / ABS END 60 * "DIST" \->TAG \>> \>> GC \<< \-> frl fr\Gl tol to\Gl \<< DEG 'COS( frl)*TAN(tol)-SIN( frl)*COS(to\Gl-fr\Gl)' \->NUM 'SIN(fr\Gl-to\Gl)' \->NUM R\->C ARG 180 RANGE \->FMT "COURSE" \->TAG 'ACOS(SIN(frl) *SIN(tol)+COS(frl)* COS(tol)*COS(to\Gl- fr\Gl))' \->NUM 60 * "DIST" \->TAG \>> \>> COMP \<< 0 0 0 0 0 0 0 0 \-> scl ll frl fr\Gl tol to\Gl vl v\Gl fc\Gl tc\Gl n d d0 sn \<< DEG frl fr\Gl tol to\Gl VERTEX fr\Gl RANGE 'v\Gl' STO 'vl' STO to\Gl fr\Gl RANGE 'tc\Gl' STO IF 'vl*SIGN (ll)\<=ABS(ll)' 'ABS( v\Gl-(fr\Gl+tc\Gl)/2)>ABS ((fr\Gl-tc\Gl)/2)AND ABS(vl)\=/90 AND ABS( ll-(frl+tol)/2)\>=ABS ((frl-tol)/2)' OR THEN "GC is OK: Hit ENTER" MESS ELSE DEPTH 'd0' STO to\Gl fr\Gl RANGE fr\Gl IF < THEN 1 ELSE -1 END 'sn' STO IFERR ll TAN INV DUP frl TAN * ACOS NEG sn * fr\Gl + 0 RANGE 'fc\Gl' STO tol TAN * ACOS sn * to\Gl + 0 RANGE 'tc\Gl' STO THEN DEPTH d0 - DROPN "No sol'n: Hit ENTER" MESS ELSE scl frl fr\Gl ll fc\Gl WAY DROP 'd' STO+ OBJ\-> 'n' STO IF 'RND (fc\Gl,6)\=/RND(tc\Gl,6)' THEN OBJ\-> SWAP DROP ll fc\Gl ll tc\Gl RHUMB 'd' STO+ SWAP \->LIST ELSE DROP -1 'n' STO+ END scl ll tc\Gl tol to\Gl WAY DROP 'd' STO+ OBJ\-> n + \->LIST d "DIST" \->TAG END END \>> \>> VERTEX \<< 0 \-> frl fr\Gl tol to\Gl C \<< DEG frl fr\Gl tol to\Gl GC DROP FMT\-> DUP 'C' STO DUP SIN frl COS * ABS ACOS frl 0 \>= 1 -1 IFTE * IF DUP 0 == THEN SWAP DROP 0 ELSE DUP ROT COS SWAP SIN / ASIN NEG IF 'C>180 ' THEN NEG END fr\Gl + IF 'ABS( tol)>ABS(frl)AND SIGN(tol)\=/SIGN(frl) ' THEN 180 + SWAP NEG SWAP END 0 RANGE END \->FMT "V_Lon" \->TAG SWAP \->FMT "V_Lat" \->TAG SWAP \>> \>> WAY \<< \-> scl frl fr\Gl tol to\Gl \<< DEG 0 frl fr\Gl tol to\Gl GC SWAP DROP 60 / frl fr\Gl GETV DUP tol to\Gl GETV CROSS DUP ABS IF DUP 0 == THEN DROP2 IF 'RND( frl,6)\=/RND(tol,6)OR RND(fr\Gl,6)\=/RND(to\Gl, 6)' THEN "Ambiguous Sol'n" 3 DISP END 0 fr\Gl 90 - GETV ELSE / END NEG 0 0 \-> d gcd r n d0 dsum \<< DEPTH 'd0' STO WHILE 'd< gcd OR d==0' REPEAT n r d SMOVE V\-> ASIN 3 ROLLD R\->C ARG 'd' scl STO+ END tol to\Gl gcd scl / FLOOR 2 + 'n' STO DUP2 "N/A" ROT \->FMT ROT \->FMT ROT 3 \->LIST DEPTH d0 - ROLLD 1 n 1 - START 4 DUPN RHUMB 'dsum' STO+ 3 ROLLD DROP2 3 ROLLD DUP2 5 ROLL ROT \->FMT ROT \->FMT ROT 3 \->LIST DEPTH d0 - ROLLD NEXT DROP2 n \->LIST dsum DUP "DIST" \->TAG SWAP gcd 60 * - '1_ nmi' \->UNIT "ADDD" \->TAG \>> \>> \>> DOUNIT \<< -55 CF IFERR CONVERT THEN DROP END UVAL \>> SD \<< 0 \-> x \<< DATE DUP 100 * FP 100 / 1.01 + SWAP DDAYS 183 - 183 / 'x' STO '( 15.762145+x*( -.02513+x*(1.15068+ x*(.02604+x*-.62672 ))))/60' \->NUM \>> \>> RMOVE \<< 0 0 0 0 \-> \Gl l d \Gh d\Gl dl n\Gl nl \<< DRLON DRLAT d \Gh CCMOVE DUP 'nl' STO DRLAT - 'dl' STO DUP 'n\Gl' STO DRLON - 'd\Gl' STO l \Gl d\Gl + GETV n\Gl 90 + DUP COS SWAP SIN 0 \->V3 SWAP dl SMOVE V\-> ASIN 3 ROLLD R\->C ARG SWAP \>> \>> SMOVE \<< \-> n r d \<< d COS r * n n r DOT * 1 d COS - * + r n CROSS d SIN * + \>> \>> CCMOVE \<< 0 \-> \Gl l d \Gh l2 \<< l d \Gh MER l + DUP 'l2' STO IF DUP ABS 90 \>= THEN SIGN 90 * \Gl SWAP ELSE IF 'ABS( COS(\Gh))<.0001' THEN ' -.998208257*d*SIN(\Gh )/COS((l+l2)/2)*\v/(1 -(ee*SIN((l+l2)/2)) ^2)' \->NUM ELSE l l2 \Gh DLo END \Gl + SWAP END \>> \>> MER \<< \-> l1 d \Gh \<< ' .998208256722/(1-ee ^2)*\.S(l1,l1+d*COS(\Gh ),(1-(ee*SIN(l))^2) ^1.5,l)' \->NUM \>> \>> DLo \<< 0 0 \-> l1 l2 \Gh sl1 sl2 \<< l1 SIN 'sl1' STO l2 SIN 'sl2' STO ' -57.2957795131*TAN( \Gh)*(ATANH((sl2-sl1) /(1-sl1*sl2))-ee* ATANH(ee*(sl2-sl1)/ (1-ee^2*sl2*sl1)))' \->NUM \>> \>> GETV \<< \-> l \Gl \<< l COS \Gl COS * l COS \Gl SIN * l SIN \->V3 \>> \>> ee 8.18188106628E-2 FMT "(dd.mmt)" FFMT 1 FFIX \<< IF 'FFMT==1' THEN 3 FIX ELSE 4 FIX END \>> FMT\-> \<< CASE 'FFMT==1 ' THEN HMT\-> END 'FFMT== 0' THEN HMS\-> END END \>> \->FMT \<< CASE 'FFMT==1 ' THEN \->HMT END 'FFMT== 0' THEN \->HMS END END \>> \->HMT \<< 4 RND DUP IP SWAP FP .6 * + \>> HMT\-> \<< DUP IP SWAP FP 1.66666667 * + \>> SVSTK { # 81388003E00FF4h # 0h } RESTS \<< SVSTK STOF FFIX \>> SAVES \<< RCLF 'SVSTK' STO -20 CF -21 CF -22 SF -55 CF \>> \GmST \<< 0 0 0 \-> s2 s3 s4 \<< 2 SK 's2' STO 3 SK 's3' STO 4 SK 's4' STO '(-s3+\v/ (s3^2-3*s4*(s2-1))) /(3*s4)' \->NUM RE UBND MIN \>> \>> UBND \<< \Ga1 \Gb1 ABS - \Ga2 \Gb2 ABS - \Ga3 \Gb3 ABS - MIN MIN \>> LBND \<< \Ga1 1.73205080757 \Gb1 ABS * - \Ga2 1.73205080757 \Gb2 ABS * - \Ga3 1.73205080757 \Gb3 ABS * - MIN MIN \>> SK \<< \-> k \<< '\Gb1^2/\Ga1^k+ \Gb2^2/\Ga2^k+\Gb3^2/\Ga3^k ' \->NUM \>> \>> G\Gm \<< \Gb1 \Ga1 \Gm - / SQ \Gb2 \Ga2 \Gm - / SQ + \Gb3 \Ga3 \Gm - / SQ + 1 - \>> ASK \<< { "YES" "" "" "" "" "NO" } TMENU 0 DO DROP -1 WAIT UNTIL DUP { 11.1 16.1 } SWAP POS DUP IF NOT THEN 880 .1 BEEP END END 0 MENU \>> MLIMB { { "LL" \<< 1 CONT \>> } "" { "UL" \<< -1 CONT \>> } "" { "CENT" \<< 0 CONT \>> } "" } MBODY { { "SUN" \<< "S" CONT \>> } { "MOON" \<< "M" CONT \>> } { "VENUS" \<< "VM" CONT \>> } { "MARS" \<< "VM" CONT \>> } { "PLANET" \<< "P" CONT \>> } { "STAR" \<< "T" CONT \>> } } PSCALE \<< \-> s a \<< IF 's\=/0' THEN 'a/( 360+a/s)' \->NUM ELSE 0 END \>> \>> tol 10 to\Gl 10 LON 89.7214000014 LAT 10.5730000011 IERR 1.6606266327E-3 LIMIT \<< 0 0 0 0 0 0 \-> g1 g2 d1 d2 d180 up \<< DUP2 C\->R 'd1' STO 'g1' STO C\->R 'd2' STO 'g2' STO IF 'ABS(g1- g2)>180' THEN DROP2 LON 180 IF 'g1> LON' THEN + ELSE - END 'up' STO 'd1+(up-g1)*(d1 -d2)/(g1-g2)' \->NUM 'd180' STO g2 d2 R\->C up 360 IF 'up> LON' THEN - ELSE + END d180 R\->C up d180 R\->C g1 d1 R\->C LINE END \>> \>> RANGE \<< \-> \Gl \<< WHILE DUP 180 \Gl + > REPEAT 360 - END WHILE DUP -180 \Gl + < REPEAT 360 + END \>> \>> LOP \<< \-> g d a l \<< IF 'ABS(l)\=/ 90' THEN 'g+ ACOS((SIN(a)-SIN(l) *SIN(d))/(COS(l)* COS(d)))' \->NUM ELSE g END DUP IM IF 0 \=/ THEN DROP g END IF 'ABS(l)> 90-ABS(d)+a' THEN 180 + END LON RANGE l R\->C \>> \>> CST { SOLVE ADDOB SETUP INIT ADV ADDDR DR PLOTP SAIL WVIEW ERROR TIME } REFRACT \<< 0 \-> h rp \<< '1/TAN(h+ 7.31/(h+4.4))' \->NUM 'rp' STO 'rp*(( PRESS-80)/930)/(1+ .00008*(rp+39)*( TMPTR-10))' \->NUM 60 / \>> \>> MESS \<< 3 DISP 7 FREEZE 0 WAIT DROP \>> PPAR { (90.5890052687,10.1563333344) (88.8537947341,10.9896666678) X 0 (0,0) FUNCTION Y } T\Gg 6 G\Gg 231.103333334 PRESS 1010 TMPTR 10 a0 '-(G12*G23-G13 *G22)*G13+(G11*G23- G12*G13)*G23-(G11* G22-G12^2)*G33' a1 'G11*G22-G12^2 +G11*G33-G13^2+G22* G33-G23^2' TF 213.112966667 CRS 320 SPD 0 EV3 '-2*\v/Q*COS((\Gh +360)/3)+N/3' EV2 'N-\Ga1-\Ga3' EV1 '-2*\v/Q*COS(\Gh/ 3)+N/3' \Gm -.178280167539 \Gb3 2.75456498847 \Gb2 4.61233514353E-2 \Gb1 1.14190212639E-2 E3 [ .338319152137 .168945881156 .925741562499 ] E2 [ .676618904731 .64002613719 -.364078839641 ] E1 [ -.65400841667 .749549086407 .102221123028 ] INTERP \<< \-> T V1 V2 \<< V1 V2 V1 - T2 T1 - / T T1 - * + \>> \>> GSUM \<< \-> DS DC GS GC HS \<< 0 'G11' STO 0 'G12' STO 0 'G13' STO 0 'G22' STO 0 'G23' STO { 3 } 0 CON 'R' STO OBS OBJ\-> OBJ\-> DROP DROP 'N' STO 1 N START SIN 'HS' STO DUP SIN 'DS' STO COS 'DC' STO DUP SIN 'GS' STO COS 'GC' STO DS SQ 'G11' STO+ DS DC GC * * 'G12' STO+ DS DC GS * * 'G13' STO+ DC SQ GC SQ * 'G22' STO+ DC SQ GS GC * * 'G23' STO+ R OBJ\-> DROP DC GS HS * * + ROT DS HS * + ROT DC GC HS * * + ROT { 3 } \->ARRY 'R' STO NEXT N G11 G22 + - 'G33' STO \>> \>> OUT \<< OBJ\-> DROP \-> U V W \<< IF 'ABS(U)> 1' THEN U SIGN 'U' STO END U ASIN V W R\->C ARG \->FMT "LON" \->TAG SWAP \->FMT "LAT" \->TAG \>> \>> UVW \<< \Gb1 \Ga1 \Gm - / E1 * \Gb2 \Ga2 \Gm - / E2 * \Gb3 \Ga3 \Gm - / E3 * + + \>> EIGEN \<< \-> EV \<< 'G12*G23- G13*G22+G13*EV' \->NUM 'G13*G12-G11* G23+G23*EV' \->NUM ' G11*G22-SQ(G12)-( G11+G22)*EV+SQ(EV)' \->NUM { 3 } \->ARRY DUP ABS IF DUP 0 \=/ THEN / ELSE DROP END \>> \>> \Ga2 .38067798101 \Ga3 2.58992744633 \Ga1 .029394572665 \Gh 'ACOS(R1/Q^1.5) ' R1 'A0/2+N/3*(A1/ 6-Q)' Q '(N/3)^2-A1/3' N 3 A0 -2.89809425646E-2 A1 1.07324802832 G33 2.27032850246 R [ .955661886936 .50345167658 2.53439002533 ] G23 .318611864541 G22 .246376558567 G13 .715412834112 G12 .298478592826 G11 .483294938977 GHA2 60.5550000011 DEC2 22.0816666668 T2 12 GHA1 45.5566666678 DEC1 22.0750000002 T1 11 LU 1 SEMI .26333333386 HP .9333333352 HGT 3.048 INDX 0 BODY "S" END '' ----------------------- CUT HERE AND AT TOP ------------------